Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyDrag.p

Text File | 1996-10-10 | 5.7 KB | 198 lines | [TEXT/CWIE]

unit MyDrag;

interface

    uses
        Types, Drag, Files, Events, TextEdit;

    function GetDropLocationDirectory( dragref: DragReference; var dropFS: FSSpec ): OSErr;
    function DragText( const er: EventRecord; localwhere: Point; te: TEHandle; handletrash: Boolean; var wasdragged, wastrashed: Boolean): OSErr;
    function DragTargetWasTrash( dragref: DragReference ): Boolean;
    function IsDragTypeAvailable ( dragref: DragReference; thetype: FlavorType ): boolean;
    function GetFlavorDataHandle ( dragref: DragReference; theitem: ItemReference; thetype: FlavorType; var data: Handle ): OSErr;
    function GetTextDragData( dragref: DragReference; data: Handle ): OSErr;

implementation

    uses
        Aliases, Folders, AppleEvents, Errors, Quickdraw, Memory,
        MyTypes, MyAEUtils, MyTextEdit, MyUtils, MyFileSystemUtils, MyRegions, MyMemory, MyLowLevel;

    function GetDropLocationDirectory( dragref: DragReference; var dropFS: FSSpec ): OSErr;
        var
            err: OSErr;
            dropLocation: AEDesc;
            isfolder, wasalias: Boolean;
            pb: CInfoPBRec;
    begin
        AECreate(dropLocation);
        err := GetDropLocation(dragref, dropLocation);
        if (err = noErr) or (err=userCanceledErr) then begin { userCanceledErr hack to deal with aliases in the finder }
            err := GetFSSpecFromAEDesc(dropLocation, dropFS);
        end;
        AEDestroy(dropLocation);
        if (err = noErr) & (dropFS.name <> '') then begin
            err := ResolveAliasFile(dropFS, true, isfolder, wasalias);
            err := FSpGetCatInfo(dropFS, pb);
            dropFS.vRefNum := pb.ioVRefNum;
            dropFS.parID := pb.ioDirID;
            dropFS.name := '';
            if (err = noErr) & (BAND(pb.ioFlAttrib, $10) = 0) then begin
                err := fnfErr;
            end;
        end;
        GetDropLocationDirectory := err;
    end;

    function DragTargetWasTrash( dragref: DragReference ): Boolean;
        var
            err: OSErr;
            dropFS: FSSpec;
            junk_vrn: integer;
            trashDirID: longint;
    begin
        DragTargetWasTrash := false;
        err := GetDropLocationDirectory( dragref, dropFS );
        if err = noErr then begin
            err := FindFolder( dropFS.vRefNum, kTrashFolderType, false, junk_vrn, trashDirID );
        end;
        if (err = noErr) & (dropFS.parID = trashDirID) then begin
            DragTargetWasTrash := true;
        end;
    end;

    function DragText( const er: EventRecord; localwhere: Point; te: TEHandle; handletrash: Boolean; var wasdragged, wastrashed: Boolean): OSErr;
        var
            err, junk: OSErr;
            dragref: DragReference;
            dragrgn: RgnHandle;
            state: SignedByte;
    begin
        err := noErr;
        wasdragged := false;
        wastrashed := false;
        if PtInTEHiliteRgn( localwhere, te ) & WaitMouseMoved( er.where ) then begin
            wasdragged := true;

            err := NewDrag( dragref );
            if err = noErr then begin
                dragrgn := NewRgn;
                state := HGetState( te^^.hText );
                HLock( te^^.hText );
                err := AddDragItemFlavor( dragref, 1, 'TEXT', AddPtrLong( te^^.hText^, te^^.selStart ), te^^.selEnd - te^^.selStart, 0 );
                HSetState( te^^.hText, state );
                if err = noErr then begin
                    err := TEGetHiliteRgn( dragrgn, te );
                end;
                if err = noErr then begin
                    LocalToGlobalRegion( dragrgn );
                    OutlineRegion( dragrgn );
                    err := TrackDrag( dragref, er, dragrgn );
                    if err = userCanceledErr then begin
                        err := noErr;
                    end;
                end;
                if err = noErr then begin
                    wastrashed := DragTargetWasTrash( dragref );
                    if handletrash & wastrashed then begin
                        TEDelete( te );
                    end;
                end;
                DisposeRgn( dragrgn );
                junk := DisposeDrag( dragref );
            end;
        end;
        DragText := err;
    end;

    function IsDragTypeAvailable ( dragref: DragReference; thetype: FlavorType ): boolean;
        var
            items, index: integer;
            flags: FlavorFlags;
            theitem: ItemReference;
            err: OSErr;
    begin
        err := CountDragItems( dragref, items );
        if err = noErr then begin
            err := errAENoUserSelection;
            for index := 1 to items do begin
                err := GetDragItemReferenceNumber( dragref, index, theitem );
                if err = noErr then begin
                    err := GetFlavorFlags( dragref, theitem, thetype, flags );
                end;
                if err <> noErr then begin
                    leave;
                end;
            end;
        end;
        IsDragTypeAvailable := err = noErr;
    end;


    function GetFlavorDataHandle ( dragref: DragReference; theitem: ItemReference; thetype: FlavorType; var data: Handle ): OSErr;
        var
            err: OSErr;
            len: Size;
    begin
        data := nil;
        err := GetFlavorDataSize( dragref, theitem, thetype, len );
        if err = noErr then begin
            err := MNewHandle( data, len );
        end;
        if err = noErr then begin
            HLock( data );
            err := GetFlavorData( dragref, theitem, thetype, data^, len, 0 );
            HUnlock( data );
        end;
        if err <> noErr then begin
            MDisposeHandle( data );
        end;
        GetFlavorDataHandle := err;
    end;

    function MergeTextHandles( data1, data2: Handle ): OSErr;
        var
            err: OSErr;
            len1, len2: longint;
    begin
        len1 := GetHandleSize( data1 );
        if len1 = 0 then begin
            err := HandAndHand( data2, data1 );
        end else begin
            len2 := GetHandleSize( data2 );
            err := MSetHandleSize( data1, len1 + 1 + len2 );
            if err = noErr then begin
                AddPtrLong( data1^, len1 )^ := ord(spc);
                BlockMoveData( data2^, AddPtrLong( data1^, len1 + 1 ), len2 );
            end;
        end;
        MergeTextHandles := err;
    end;

    function GetTextDragData( dragref: DragReference; data: Handle ): OSErr;
        var
            err: OSErr;
            i, items: integer;
            theitem: ItemReference;
            thedata: Handle;
    begin
        SetHandleSize( data, 0 );
        err := CountDragItems( dragref, items );
        if err = noErr then begin
            for i := 1 to items do begin
                thedata := nil;
                err := GetDragItemReferenceNumber( dragref, i, theitem );
                if err = noErr then begin
                    err := GetFlavorDataHandle( dragref, theitem, 'TEXT', thedata );
                end;
                if err = noErr then begin
                    err := MergeTextHandles( data, thedata );
                end;
                MDisposeHandle( thedata );
            end;
        end;
        GetTextDragData := err;
    end;

end.